home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / OBJHANDL.I < prev    next >
Encoding:
Modula Implementation  |  1991-09-03  |  66.8 KB  |  2,340 lines
  1. IMPLEMENTATION MODULE ObjHandler;
  2. (*$L-, R-, J-, Y+*)
  3.  
  4. (*      Implementation der MEGAMAX MODULA II GEM Library (ObjectHandler) *
  5.  *                                                                       *
  6.  *      geschrieben von Manuel Chakravarty                               *
  7.  *                                                                       *
  8.  *      Version 2.1     V#0233          Created 30.06.1987               *)
  9.  
  10. (* 30.6 - 11.08 | 'CreateObjTree', Vorversion von 'VanishObjTree', Fkt zum
  11.  *                anwählen der einzelnen Objekte und setzen bzw. erfragen
  12.  *                des mom. Treeptrs., erste Version von 'ObjTreeError', als
  13.  *                Nachfragefkt. und die Fkt zum Setzen und erfragen der
  14.  *                einzelnen Objektparameter, bis  auf den 'ApplBlock' für
  15.  *                Obj. vom Typ 'progDef'.
  16.  * 12.8         | Berücksichtigung der Besonderheiten von 'button', 'string
  17.  *                und 'title' Objekten. D.h. ändern von 'CreateSpec..' und
  18.  *                von 'AssignTextStrings' und 'GetTextStrings', außerdem
  19.  *                Verbot der Benutzung aller Operationen die eine 'TedInfo'
  20.  *                verlangen für diese Objekttypen. Einführung von 'noChange
  21.  *                bei 'SetPtrChoice' mit entspr. Änderungen bei 'setString'
  22.  * 14.8         | Erste Def. für ApplBlock Behandlung
  23.  * 18.8-19.8    | 'ApplBlock' Routinen implementieren und testen.
  24.  * 24.8         | ComplexColor und BorderThick-Routinen für 'fText' und
  25.  *                'text' erlaubt.
  26.  * 25.8         | 'OStateSet' als Rückgabeparam. von 'ProgDefProc's impl.
  27.  * 1.9          | V 0.3 -- Namensänderungen und Anpassung an GEMLibrary
  28.  *                         V 0.7
  29.  * 25.10+26.10  | 'Cur' -> 'Curr' + 'obj' in jede Routine + Sys-Anmeldung +
  30.  *                'DeleteTree' vollständig
  31.  * 18.12        | 'BorderThickness' liefert neg. Werte nun richtig
  32.  * 22.01.88  TT | 'setObjFlags': A3-Behandlung korrgiert
  33.  * 17.05.88     | 'LeftSister' korrigiert
  34.  * 08.12.88     | 'GetTextStrings' funktioniert jetzt auch für Objekte, deren
  35.  *                spec. ein Zeiger auf einen String ist.
  36.  * 02.08.89     | 'CreateSpecification': A3-Behandlung im Fehlerfall korrigiert
  37.  * 11.08.89     | 'AssignTextStrings': A3-Behandlung für 'textOnly' korrigiert
  38.  * ???????? TT  | REF-Parm.
  39.  * 15.02.90     | Anpassung an Compilerversion 4.0
  40.  * 06.10.90     | Keine Verdrehung in SETs mehr
  41.  * ??.11.90     | Irgendeine Korrektur f. UserDef-Objs
  42.  * 17.04.91 TT  | MakeProgDefProc: "MOVE from SR" entfernt;
  43.  *                CreateSpecification: Bei 'spec # 0' wurde indirectFlg verkehrt
  44.  *                ausgewertet, was immer zu Busfehlern führte.
  45.  * 04.09.91 !MS | Modul kommt nun mit erweiterten Objekttypen zurecht.
  46.  *)
  47.  
  48.  
  49. FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, LONGWORD, WORD,
  50.                    TSIZE;
  51.  
  52. FROM Storage IMPORT SysAlloc, ALLOCATE, DEALLOCATE;
  53.  
  54. FROM MOSGlobals IMPORT MemArea, StringOverflow;
  55.  
  56. FROM GrafBase IMPORT Point, Rectangle, PtrBitPattern;
  57.  
  58. FROM GEMGlobals IMPORT NoObject, Root,
  59.                        PtrObjTree, ObjType, OStateSet, OFlagSet, PtrObjSpec,
  60.                        THorJust, PtrMaxStr, Object, TEdInfo, BitBlock,
  61.                        IconBlock, ApplBlock, ObjState, ObjFlag, ObjSpec;
  62.  
  63.         
  64. CONST   G_BOX           =20;    (* Objektkonstanten a'la C *)
  65.  
  66.         noErrorTrap     =6;
  67.  
  68.  
  69. VAR     sizeOfObject                    :CARDINAL;     (* TSIZE(Object) *)
  70.         sizeOfTed,sizeOfIcon,sizeOfBit,
  71.         sizeOfAppl                      :LONGCARD;
  72.         
  73.         currentObjTree                  :PtrObjTree;   (* mom. Obj.Baum *)
  74.         currentObject,endObject         :CARDINAL;     (* mom.+letztes Obj *)
  75.         currentObjAddr                  :ADDRESS;      (* ADR(mom.Obj)  *)
  76.         objTreeError                    :BOOLEAN;      (* Fehlerspeicher*)
  77.         sysTree                         :BOOLEAN;
  78.         
  79.         voidC           : CARDINAL;
  80.         
  81.         
  82.                 (* Operationen auf Objektbäume *)
  83.                 
  84. FORWARD setObjFlags(flags:OFlagSet);
  85. FORWARD objectFlags():OFlagSet;
  86. FORWARD setCurrObject(obj:CARDINAL);
  87. FORWARD objectType():ObjType;
  88.  
  89. (* calcLastObject -- geg.: Aktueller Objektbaum                             *
  90.  *                   ges.: Index des letzten Objects (lastObject IN flags)  *)
  91.  
  92. PROCEDURE calcLastObject():CARDINAL;
  93.  
  94. BEGIN
  95.   ASSEMBLER
  96.         MOVE.W  sizeOfObject,D0         ; TSIZE(Object) -> D0
  97.         CLR.W   D1                      ; Indexzähler
  98.         MOVE.L  currentObjTree,A0
  99.         LEA     Object.flags(A0),A0     ; Addr. der Flags des Elements
  100.         SUBA.W  D0,A0                   ; Wegen Schleifenaufbau
  101. loop
  102.         ADDA.W  D0,A0                   ; Nächstes Element
  103.         ADDQ.W  #1,D1
  104.         MOVE.W  (A0),D2                 ; Flags -> D2
  105.         BTST    #lastObjFlg,D2
  106.         BEQ     loop                    ; again, if (NOT 'lastObject' IN flags)
  107.         SUBQ.W  #1,D1                   ; Index berichtigen
  108.         MOVE.W  D1,(A3)+                ; und zurückgeben
  109.   END;
  110. END calcLastObject;
  111.  
  112. (*  validTree -- liefert TRUE, falls KEINE Operation auf den mom. Baum aus- *
  113.  *               geführt werden darf(z.B.: 'currentObjTree=NIL',etc.).      *
  114.  *               Muß nicht von allen Operationen ausgerufen werden(z.B.:    *
  115.  *               nicht von 'CreateObjTree').                                *)
  116.  
  117. PROCEDURE validTree():BOOLEAN;
  118.  
  119. BEGIN
  120.   ASSEMBLER
  121.         TST.L   currentObjTree
  122.         BEQ     notValid                ; 'curObjTree=NIL' => Fehler
  123.         MOVE.W  currentObject,D0
  124.         CMP.W   #NoObject,D0
  125.         BEQ     notValid                ; 'curObject=NoObject' => Fehler
  126.         CLR     (A3)+
  127.         RTS
  128. notValid
  129.         MOVE.W  #TRUE,(A3)+
  130.   END;
  131. END validTree;
  132.  
  133. (*  calcSpecAddr  -- Liefert die Addresse der Specifiktion des mom. Objekts *
  134.  *                   in A0, dabei wird das Indirect-Flag beachtet.          *
  135.  
  136.  *                      Nur von Assemblerteilen benutzen !!                 *)
  137.  
  138. PROCEDURE calcSpecAddr;
  139.  
  140. BEGIN
  141.   ASSEMBLER
  142.         JSR     objectFlags
  143.         MOVE.W  -(A3), D0
  144.         ;ROR.W   #8, D0
  145.         MOVE.L  currentObjAddr,A0
  146.         LEA     Object.spec(A0),A0
  147.         BTST    #indirectFlg,D0
  148.         BEQ     ende
  149.         MOVE.L  (A0),A0
  150. ende
  151.   END;
  152. END calcSpecAddr;
  153.  
  154. PROCEDURE ObjTreeError():BOOLEAN;
  155.  
  156. BEGIN
  157.   ASSEMBLER
  158.         MOVE.W  objTreeError,(A3)+
  159.         CLR.W   objTreeError
  160.   END;
  161. END ObjTreeError;
  162.          
  163. PROCEDURE CreateObjTree (noElements:CARDINAL; sys:BOOLEAN; VAR success:BOOLEAN);
  164.  
  165. VAR     elem            :LONGCARD;
  166.  
  167. (*$L+*)
  168. BEGIN
  169.   sysTree:=sys;
  170.   elem:=noElements;
  171.   
  172.   IF elem=0L THEN currentObjTree:=NIL
  173.   ELSE
  174.     IF sysTree THEN SysAlloc(currentObjTree,TSIZE(Object)*elem)
  175.     ELSE ALLOCATE(currentObjTree,TSIZE(Object)*elem) END;
  176.     IF currentObjTree=NIL THEN success:=FALSE; RETURN END;
  177.   END;
  178.   
  179.   IF currentObjTree=NIL THEN
  180.     currentObject:=NoObject;
  181.     endObject:=NoObject;
  182.   ELSE
  183.     endObject:=noElements-1;           (* Merke dir und *)
  184.     setCurrObject(endObject);          (* markiere letztes Objekt *)
  185.     setObjFlags(OFlagSet{lastObjFlg});
  186.     setCurrObject(Root);
  187.   END;
  188.   success:=TRUE;
  189. END CreateObjTree;
  190. (*$L-*)
  191.          
  192. PROCEDURE SetCurrObjTree(tree:PtrObjTree; sys:BOOLEAN);
  193.  
  194. BEGIN
  195.   ASSEMBLER
  196.         MOVE.W  -(A3),sysTree
  197.         MOVE.L  -(A3),currentObjTree
  198.         JSR     calcLastObject          ; neues letztes Objekt
  199.         MOVE.W  -(A3),endObject
  200.         MOVE.W  #Root,(A3)+             ; Wurzel -> mom. Objekt
  201.         JSR     setCurrObject
  202.         CLR.W   objTreeError
  203.   END;
  204. END SetCurrObjTree;
  205.          
  206. PROCEDURE CurrObjTree():PtrObjTree;
  207.         
  208. BEGIN
  209.   ASSEMBLER
  210.         MOVE.L  currentObjTree,(A3)+
  211.         CLR.W   objTreeError
  212.   END;
  213. END CurrObjTree;
  214.  
  215.  
  216. (* deAllocA0 -- 'DEALLOCATE(A0^,0L)', falls 'A0#NIL' *)
  217.         
  218. PROCEDURE deAllocA0;
  219.     
  220. BEGIN
  221.   ASSEMBLER
  222.         CMPA.L  #NIL,A0
  223.         BEQ     ende
  224.         MOVE.L  A0,(A3)+
  225.         CLR.L   (A3)+
  226.         JSR     DEALLOCATE
  227. ende
  228.   END;
  229. END deAllocA0;
  230.     
  231. (*  delObjSpec -- Löscht die Objectspezifikation des mom. Objektes *)
  232.    
  233. PROCEDURE delObjSpec;
  234.  
  235. (*$L+*)
  236. VAR   ptrPtrSpec, ptrSpec     : ADDRESS;
  237.  
  238. BEGIN
  239.   ASSEMBLER
  240.         JSR     objectType
  241.         JSR     objectFlags
  242.         MOVE.W  -(A3), D1
  243.         ;ROR.W   #8, D1
  244.         MOVE.W  -(A3),D0        ; Object.Type -> D0
  245.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  246.         
  247.         MOVE.L  currentObjAddr,A0
  248.         LEA     Object.spec(A0),A0
  249.         
  250.         MOVE.L  #NIL,ptrPtrSpec(A6)
  251.         BTST    #indirectFlg,D1
  252.         BEQ     noInd
  253.         MOVE.L  A0,ptrPtrSpec(A6)
  254.         MOVE.L  (A0),A0
  255. noInd
  256.         MOVE.L  A0,ptrSpec(A6)
  257.         
  258.         CMP.W   #boxObj,D0      ; mom. 'Object.type=boxObj, iBoxObj, boxChar',
  259.         BEQ.W   noMore          ; dann springe zu 'noMore'
  260.         CMP.W   #iBoxObj,D0
  261.         BEQ.W   noMore
  262.         CMP.W   #boxCharObj,D0
  263.         BEQ.W   noMore
  264.         CMP.W   #textObj,D0        ; mom. 'Object.type=textObj, boxTextObj, buttonObj,
  265.         BEQ     deAllocTed      ;       fText, fBoxText',
  266.         CMP.W   #boxTextObj,D0     ; dann springe zu 'deAllocTed'
  267.         BEQ     deAllocTed
  268.         CMP.W   #buttonObj,D0
  269.         BEQ.W   deAllocStr
  270.         CMP.W   #stringObj,D0
  271.         BEQ.W   deAllocStr
  272.         CMP.W   #fTextObj,D0
  273.         BEQ     deAllocTed
  274.         CMP.W   #fBoxTextObj,D0
  275.         BEQ     deAllocTed
  276.         CMP.W   #titleObj,D0
  277.         BEQ.W   deAllocStr
  278.         CMP.W   #imageObj,D0       ; type=imageObj
  279.         BEQ     deAllocBit
  280.         CMP.W   #progDefObj,D0     ; type=progDefObj
  281.         BEQ     deAllocAppl
  282.         CMP.W   #iconObj,D0        ; type=iconObj
  283.         BEQ     deAllocIcon
  284.         
  285.         MOVE.W  #TRUE,objTreeError
  286.         BRA.W   ende            ; sollte nie vorkommen
  287.         
  288. noMore
  289.         CMPA.L  #NIL,A0
  290.         BEQ     noClr
  291.         CLR.L   (A0)
  292. noClr
  293.         BRA     noSpec
  294.         
  295. deAllocTed
  296.         CMPA.L  #NIL,A0
  297.         BEQ     noSpec
  298.         LEA     TEdInfo.textPtr(A0),A0
  299.         JSR     deAllocA0
  300.         MOVE.L  ptrSpec(A6),A0
  301.         LEA     TEdInfo.tmpltPtr(A0),A0
  302.         JSR     deAllocA0
  303.         MOVE.L  ptrSpec(A6),A0
  304.         LEA     TEdInfo.validPtr(A0),A0
  305.         JSR     deAllocA0
  306.         BRA     deAlloc
  307.         
  308. deAllocBit
  309.         CMPA.L  #NIL,A0
  310.         BEQ     noSpec
  311.         LEA     BitBlock.data(A0),A0
  312.         JSR     deAllocA0
  313.         BRA     deAlloc
  314.         
  315. deAllocAppl
  316.         BRA     deAlloc
  317.   
  318. deAllocIcon
  319.         CMPA.L  #NIL,A0
  320.         BEQ     noSpec
  321.         LEA     IconBlock.mask(A0),A0
  322.         JSR     deAllocA0
  323.         MOVE.L  ptrSpec(A6),A0
  324.         LEA     IconBlock.data(A0),A0
  325.         JSR     deAllocA0
  326.         BRA     deAlloc
  327.         
  328. deAllocStr
  329.         JSR     deAllocA0
  330.         BRA     noSpec
  331.   
  332. deAlloc
  333.         MOVE.L  ptrSpec(A6),A0
  334.         JSR     deAllocA0
  335. noSpec
  336.         MOVE.L  ptrPtrSpec(A6),A0
  337.         JSR     deAllocA0
  338.         
  339. ende
  340.   END;
  341. END delObjSpec;
  342. (*$L=*)
  343.   
  344. PROCEDURE DeleteObjTree;
  345.  
  346. BEGIN
  347.   ASSEMBLER
  348.         MOVE.L  D4,-(A7)
  349.         MOVE.W  #FALSE,objTreeError
  350.         
  351.         MOVE.L  currentObjTree,A0
  352.         CMPA.L  #NIL,A0
  353.         BEQ     noDealloc
  354.         
  355.         MOVE.W  endObject,D4            ; dealloc. all objects
  356. loop
  357.         MOVE.W  D4,(A3)+
  358.         JSR     setCurrObject
  359.         JSR     delObjSpec
  360.         DBF     D4,loop
  361.         
  362.         MOVE.L  currentObjTree,(A3)+
  363.         CLR.L   (A3)+
  364.         JSR     DEALLOCATE
  365.         MOVE.L  #NIL,currentObjTree
  366. noDealloc
  367.         MOVE.W  #NoObject,D0
  368.         MOVE.W  D0,currentObject
  369.         MOVE.W  D0,endObject
  370.         MOVE.L  #NIL,currentObjAddr
  371.         CLR.W   objTreeError
  372.         
  373.         MOVE.L  (A7)+,D4
  374.   END;
  375. END DeleteObjTree;
  376.  
  377.  
  378. PROCEDURE setCurrObject(obj:CARDINAL);
  379.  
  380. BEGIN
  381.   ASSEMBLER
  382.         MOVE.W  -(A3),D0
  383.         TST.L   currentObjTree
  384.         BEQ     err                     ; 'CurrObjTree=NIL' => Fehler
  385.         CMP.W   endObject,D0
  386.         BLS     cont                    ; springe falls 'obj<=endObject'
  387. err
  388.         MOVE.W  #TRUE,objTreeError      ; Fehler !
  389.         RTS
  390. cont
  391.         MOVE.W  D0,currentObject
  392.         MULU    sizeOfObject,D0         ; Berechne Anfangsaddresse des
  393.         MOVE.L  currentObjTree,A0       ; momentanen Objekts
  394.         ADDA.L  D0,A0
  395.         MOVE.L  A0,currentObjAddr       ; -> 'currentObjAddr'
  396.         CLR.W   objTreeError
  397.   END;
  398. END setCurrObject;
  399.          
  400. PROCEDURE currObject():CARDINAL;
  401.         
  402. BEGIN
  403.   ASSEMBLER
  404.         MOVE.W  currentObject,(A3)+
  405.         CLR.W   objTreeError
  406.   END;
  407. END currObject;
  408.         
  409. PROCEDURE LastObject():CARDINAL;
  410.  
  411. BEGIN
  412.   ASSEMBLER
  413.         MOVE.W  endObject,(A3)+
  414.         CLR.W   objTreeError
  415.   END;
  416. END LastObject;
  417.          
  418.          
  419. PROCEDURE SetObjType(obj:CARDINAL; type:ObjType);
  420.         
  421. BEGIN
  422.   ASSEMBLER
  423.         MOVE.W  -4(A3),(A3)+
  424.         JSR     setCurrObject
  425.         TST.W   objTreeError
  426.         BNE     err
  427.         
  428.         JSR     validTree
  429.         MOVE.W  -(A3),objTreeError
  430.         BNE     err
  431.         MOVE.L  currentObjAddr,A0
  432.         MOVE.W  -(A3),D0
  433.         ADD.W   #G_BOX,D0
  434.         MOVE.W  D0,Object.type(A0)
  435.         BRA     ende
  436. err
  437.         SUBQ.L  #2,A3
  438. ende
  439.         SUBQ.L  #2,A3
  440.   END;
  441. END SetObjType;
  442.         
  443. PROCEDURE objectType():ObjType;
  444.  
  445. BEGIN
  446.   ASSEMBLER
  447.         JSR     validTree
  448.         MOVE.W  -(A3),objTreeError
  449.         BNE     err
  450.         MOVE.L  currentObjAddr,A0
  451.         MOVE.W  Object.type(A0),D0
  452.         SUB.W   #G_BOX,D0               ; conversion
  453.         MOVE.W  D0,(A3)+
  454.         BRA     ende
  455. err
  456.         CLR.W   (A3)+
  457. ende
  458.   END;
  459. END objectType;
  460.          
  461. PROCEDURE ObjectType(obj:CARDINAL):ObjType;
  462.         
  463. BEGIN
  464.   ASSEMBLER
  465.         JSR     setCurrObject
  466.         TST.W   objTreeError
  467.         BNE     err
  468.         JSR     objectType
  469.         BRA     ende
  470. err
  471.         CLR.W   (A3)+
  472. ende
  473.   END;
  474. END ObjectType;
  475.          
  476. PROCEDURE setObjFlags(flags:OFlagSet);
  477.  
  478. BEGIN
  479.   ASSEMBLER
  480.         JSR     validTree
  481.         MOVE.W  -(A3),objTreeError
  482.         BNE     err
  483.         MOVE.L  currentObjAddr,A0
  484.         MOVE.W  -(A3),D0
  485.         ;ROR.W   #8,D0
  486.         MOVE.W  D0,Object.flags(A0)
  487.         RTS
  488. err
  489.         SUBQ.L  #2,A3
  490.   END;
  491. END setObjFlags;
  492.  
  493. PROCEDURE SetObjFlags(obj:CARDINAL; flags:OFlagSet);
  494.  
  495. BEGIN
  496.   ASSEMBLER
  497.         MOVE.W  -4(A3),(A3)+
  498.         JSR     setCurrObject
  499.         TST.W   objTreeError
  500.         BNE     err
  501.         
  502.         JSR     setObjFlags
  503.         BRA     ende
  504. err
  505.         SUBQ.L  #2,A3
  506. ende
  507.         SUBQ.L  #2,A3
  508.   END;
  509. END SetObjFlags;
  510.         
  511. PROCEDURE objectFlags():OFlagSet;
  512.  
  513. BEGIN
  514.   ASSEMBLER
  515.         JSR     validTree
  516.         MOVE.W  -(A3),objTreeError
  517.         BNE     err
  518.         MOVE.L  currentObjAddr,A0
  519.         MOVE.W  Object.flags(A0), D0
  520.         ;ROR.W   #8, D0
  521.         MOVE.W  D0, (A3)+
  522.         RTS
  523. err
  524.         CLR.W   (A3)+
  525.   END
  526. END objectFlags;
  527.  
  528. PROCEDURE ObjectFlags(obj:CARDINAL):OFlagSet;
  529.         
  530. BEGIN
  531.   ASSEMBLER
  532.         JSR     setCurrObject
  533.         TST.W   objTreeError
  534.         BNE     err
  535.         JMP     objectFlags
  536. err
  537.         CLR.W   (A3)+
  538.   END;
  539. END ObjectFlags;
  540.         
  541. PROCEDURE SetObjState(obj:CARDINAL; state:OStateSet);
  542.         
  543. BEGIN
  544.   ASSEMBLER
  545.         MOVE.W  -4(A3),(A3)+
  546.         JSR     setCurrObject
  547.         TST.W   objTreeError
  548.         BNE     err
  549.         
  550.         JSR     validTree
  551.         MOVE.W  -(A3),objTreeError
  552.         BNE     err
  553.         MOVE.L  currentObjAddr,A0
  554.         MOVE.W  -(A3), Object.state(A0)
  555.         BRA     ende
  556. err
  557.         SUBQ.L  #2,A3
  558. ende
  559.         SUBQ.L  #2,A3
  560.   END;
  561. END SetObjState;
  562.         
  563. PROCEDURE objectState():OStateSet;
  564.  
  565. BEGIN
  566.   ASSEMBLER
  567.         JSR     validTree
  568.         MOVE.W  -(A3),objTreeError
  569.         BNE     err
  570.         MOVE.L  currentObjAddr,A0
  571.         MOVE.W  Object.state(A0), (A3)+
  572.         BRA     ende
  573. err
  574.         CLR.W   (A3)+
  575. ende
  576.   END;
  577. END objectState;
  578.  
  579. PROCEDURE ObjectState(obj:CARDINAL):OStateSet;
  580.         
  581. BEGIN
  582.   ASSEMBLER
  583.         JSR     setCurrObject
  584.         TST.W   objTreeError
  585.         BNE     err
  586.         JSR     objectState
  587.         BRA     ende
  588. err
  589.         CLR.W   (A3)+
  590. ende
  591.   END;
  592. END ObjectState;
  593.         
  594. PROCEDURE SetObjSpace(obj:CARDINAL; space:Rectangle);
  595.  
  596. BEGIN
  597.   ASSEMBLER
  598.         MOVE.W  -10(A3),(A3)+
  599.         JSR     setCurrObject
  600.         TST.W   objTreeError
  601.         BNE     err
  602.         
  603.         JSR     validTree
  604.         MOVE.W  -(A3),objTreeError
  605.         BNE     err
  606.         MOVE.L  currentObjAddr,A0
  607.         MOVE.L  -(A3),Object.space+4(A0)        ; speichere w,h
  608.         MOVE.L  -(A3),Object.space(A0)          ; speichere x,y
  609.         BRA     ende
  610. err
  611.         SUBQ.L  #8,A3
  612. ende
  613.         SUBQ.L  #2,A3
  614.   END;
  615. END SetObjSpace;
  616.         
  617. PROCEDURE ObjectSpace(obj:CARDINAL):Rectangle;
  618.  
  619. BEGIN
  620.   ASSEMBLER
  621.         JSR     setCurrObject
  622.         TST.W   objTreeError
  623.         BNE     err
  624.         JSR     validTree
  625.         MOVE.W  -(A3),objTreeError
  626.         BNE     err
  627.         MOVE.L  currentObjAddr,A0
  628.         MOVE.L  Object.space(A0),(A3)+          ; hole x,y
  629.         MOVE.L  Object.space+4(A0),(A3)+        ; hole w,h
  630.         BRA     ende
  631. err
  632.         CLR.L   (A3)+
  633.         CLR.L   (A3)+
  634. ende
  635.   END;
  636. END ObjectSpace;
  637.         
  638. PROCEDURE SetObjRelatives(obj:CARDINAL; next,head,tail:CARDINAL);
  639.  
  640. BEGIN
  641.   ASSEMBLER
  642.         MOVE.W  -8(A3),(A3)+
  643.         JSR     setCurrObject
  644.         TST.W   objTreeError
  645.         BNE     err
  646.         
  647.         JSR     validTree
  648.         MOVE.W  -(A3),objTreeError
  649.         BNE     err
  650.         MOVE.L  currentObjAddr,A0
  651.         MOVE.L  -(A3),Object.head(A0)   ; speichere 'head' und 'tail'
  652.         MOVE.W  -(A3),Object.next(A0)   ; speichere 'next'
  653.         BRA     ende
  654. err
  655.         SUBQ.L  #6,A3                   ; Param. vom Stack schmeißen
  656. ende
  657.         SUBQ.L  #2,A3
  658.   END;
  659. END SetObjRelatives;
  660.          
  661. PROCEDURE GetObjRelatives(obj:CARDINAL; VAR next,head,tail:CARDINAL);
  662.  
  663. BEGIN
  664.   ASSEMBLER
  665.         MOVE.W  -14(A3),(A3)+
  666.         JSR     setCurrObject
  667.         TST.W   objTreeError
  668.         BNE     err
  669.         
  670.         JSR     validTree
  671.         MOVE.W  -(A3),objTreeError
  672.         BNE     err
  673.         MOVE.L  currentObjAddr,A0
  674.         MOVE.L  -(A3),A1
  675.         MOVE.W  Object.tail(A0),(A1)
  676.         MOVE.L  -(A3),A1
  677.         MOVE.W  Object.head(A0),(A1)
  678.         MOVE.L  -(A3),A1
  679.         MOVE.W  Object.next(A0),(A1)
  680.         BRA     ende
  681. err
  682.         SUBA.W  #12,A3                  ; A3-Stack korrigieren
  683. ende
  684.         SUBQ.L  #2,A3
  685.   END;
  686. END GetObjRelatives;
  687.         
  688. PROCEDURE Parent(obj:CARDINAL):CARDINAL;
  689.  
  690. BEGIN
  691.   ASSEMBLER
  692.         MOVE.W  -2(A3),(A3)+            ; 'obj' verdoppeln
  693.         JSR     setCurrObject
  694.         JSR     validTree
  695.         MOVE.W  -(A3),objTreeError
  696.         BNE     err
  697.         
  698.         MOVE.W  -2(A3),D0               ; Init D0 mit 'obj'
  699.         MOVE.L  currentObjAddr,A0       ; Init A0
  700. loop
  701.         MOVE.W  D0,D1
  702.         MOVE.W  Object.next(A0),D0
  703.         CMP.W   #NoObject,D0
  704.         BNE     cont                    ; springe, falls 'next#NoObject'
  705. err
  706.         ; 'obj' ist immer noch auf dem A3-Stack
  707.         MOVE.W  #TRUE,objTreeError
  708.         BRA     ende
  709.         
  710. cont
  711.         MOVE.W  D0,(A3)+
  712.         MOVE.W  D0,-(A7)                ; D0 retten
  713.         MOVE.W  D1,-(A7)                ; D1 retten
  714.         JSR     setCurrObject           ; SetCurrObject(next)
  715.         MOVE.W  (A7)+,D1                ; D1 wiederherstellen
  716.         MOVE.W  (A7)+,D0                ; D0 wiederherstellen
  717.         TST.W   objTreeError
  718.         BNE     err                     ; springe, falls 'next' nicht im Baum
  719.         MOVE.L  currentObjAddr,A0
  720.         CMP.W   Object.tail(A0),D1
  721.         BNE     loop                    ; springe, falls noch nicht parent
  722.         
  723.         TST.W   -(A3)                   ; A3-Stack korrigieren
  724.         MOVE.W  D0,(A3)+
  725. ende
  726.   END;
  727. END Parent;
  728.          
  729. PROCEDURE LeftSister(obj:CARDINAL):CARDINAL;
  730.  
  731. BEGIN
  732.   ASSEMBLER
  733.         MOVE.L  D3,-(A7)
  734.         JSR     setCurrObject
  735.         TST.W   objTreeError
  736.         BNE.W   err
  737.         
  738.         JSR     validTree
  739.         MOVE.W  -(A3),objTreeError
  740.         BNE.W   err
  741.         
  742.         JSR     currObject
  743.         MOVE.W  -2(A3),D3               ; 'obj' -> D3
  744.         JSR     Parent                  ; Suche parent
  745.         TST.W   objTreeError
  746.         BNE     err
  747.         
  748.         JSR     setCurrObject
  749.         TST.W   objTreeError
  750.         BNE     err                     ; jump, if parent not avaible
  751.         
  752.         JSR     currObject
  753.         LEA     voidC,A0
  754.         MOVE.L  A0,(A3)+
  755.         SUBQ.L  #2,A7
  756.         MOVE.L  A7,(A3)+
  757.         MOVE.L  A0,(A3)+
  758.         JSR     GetObjRelatives
  759.         MOVE.W  (A7)+,D0
  760.         TST.W   objTreeError
  761.         BNE     err                     ; springe, falls tail nicht vorhanden
  762.         
  763.         MOVE.W  D0,(A3)+
  764.         JSR     setCurrObject
  765.         TST.W   objTreeError
  766.         BNE     err                     ; springe, falls tail nicht vorhanden
  767. loop
  768.         MOVE.L  currentObjAddr,A0
  769.         CMP.W   Object.next(A0),D3
  770.         BEQ     cont                    ; jump, if right of found Obj='obj'
  771.         JSR     currObject
  772.         JSR     RightSister             ; to right sister
  773.         MOVE.W  -(A3),D0
  774.         TST.W   objTreeError
  775.         BNE     err
  776.         MOVE.W  D0,(A3)+
  777.         JSR     setCurrObject
  778.         TST.W   objTreeError
  779.         BEQ     loop                    ; jump, if no error
  780. err
  781.         MOVE.W  D3,(A3)+
  782.         MOVE.W  #TRUE,objTreeError
  783.         BRA     ende
  784. cont
  785.         JSR     currObject
  786. ende
  787.         MOVE.L  (A7)+,D3
  788.   END;
  789. END LeftSister;
  790.          
  791. PROCEDURE RightSister(obj:CARDINAL):CARDINAL;
  792.  
  793. BEGIN
  794.   ASSEMBLER
  795.         JSR     setCurrObject
  796.         JSR     validTree
  797.         MOVE.W  -(A3),objTreeError
  798.         BNE     err
  799.         
  800.         JSR     currObject
  801.         MOVE.W  -(A3),D0                ; mom. Objekt -> D0
  802.         MOVE.L  currentObjAddr,A0
  803.         MOVE.W  Object.next(A0),(A3)+
  804.         MOVE.W  D0,-(A7)
  805.         JSR     setCurrObject            ; SetCurrObject(next)
  806.         MOVE.W  (A7)+,D0
  807.         TST.W   objTreeError
  808.         BNE     err                     ; Fehler, falls 'next' nicht im Baum
  809.         
  810.         MOVE.L  currentObjAddr,A0
  811.         CMP.W   Object.tail(A0),D0
  812.         BNE     cont                    ; springe, falls 'next'#parent
  813. err
  814.         MOVE.W  D0,(A3)+
  815.         MOVE.W  #TRUE,objTreeError
  816.         BRA     ende
  817. cont
  818.         JSR     currObject              ; RETURN CurrObject()
  819. ende
  820.   END;
  821. END RightSister;
  822.          
  823. PROCEDURE CreateSpecification(obj:CARDINAL; spec:PtrObjSpec);
  824.  
  825. (*$L+*)
  826. VAR     addr    : ADDRESS;
  827.  
  828. BEGIN
  829.   ASSEMBLER
  830.         ;  D3 ~ momentaner Object.type
  831.         ;  A4 ~ 'spec'
  832.         
  833.         MOVEM.L D3/A4,-(A7)     ; rette D3 und A4
  834.         MOVE.L  spec(A6),A4     ; 'spec' -> A4
  835.         MOVE.W  obj(A6),(A3)+
  836.         JSR     setCurrObject   ; setCurrObject(obj)
  837.         JSR     validTree
  838.         MOVE.W  -(A3),objTreeError
  839.         BNE.W   ende
  840.         JSR     objectType      ; hole Type in D3
  841.         MOVE.W  -(A3),D3
  842.         ANDI.W  #$00FF, D3      ; !MS high-byte bleibt unberücksichtigt
  843.         CMP.W   #titleObj,D3
  844.         BHI.W   err
  845.         JSR     objectFlags     ; hole Flags des mom. Obj. -> D0
  846.         MOVE.W  -(A3), D0
  847.         ;ROR.W   #8, D0
  848.         MOVE.L  A4,D1
  849.         BNE.W   setIt           ; springe, falls 'spec' einen Wert hat
  850.         BTST    #indirectFlg,D0
  851.         BNE     crtIndirect     ; springe, falls 'indirectFlg' gesetzt
  852.         MOVE.L  currentObjAddr,A0       ; fülle direkt in mom. 'Object.spec'
  853.         LEA     Object.spec(A0),A0
  854.         BRA     fillSpec
  855. crtIndirect
  856.         LEA     addr(A6),A0
  857.         MOVE.L  A0,(A3)+
  858.         MOVE.L  #4,(A3)+
  859.         
  860.         TST.W   sysTree
  861.         BNE     allocSys1
  862.         JSR     ALLOCATE        ; ALLOCATE(zws,4L), alloc. ein ObjSpec
  863.         BRA     endAlloc1
  864. allocSys1
  865.         JSR     SysAlloc
  866. endAlloc1
  867.  
  868.         LEA     addr(A6),A0
  869.         MOVE.L  (A0),D0
  870.         BEQ.W   err             ; Kein Speicher => Fehler
  871.         MOVE.L  D0,A0
  872.         MOVE.L  currentObjAddr,A1
  873.         MOVE.L  A0,Object.spec(A1)
  874. fillSpec                ; A0 ~ Zeiger auf zu bearbeitenden ObjSpec
  875.         CMP.W   #boxObj,D3         ; mom. 'Object.type=boxObj, iBoxObj, boxCharObj',
  876.         BEQ.W   noMore          ; dann springe zu 'noMore'
  877.         CMP.W   #iBoxObj,D3
  878.         BEQ.W   noMore
  879.         CMP.W   #boxCharObj,D3
  880.         BEQ.W   noMore
  881.         LEA     addr(A6),A1     ; Weil ALLOCATE VAR-Param. verlangt
  882.         MOVE.L  A1,(A3)+
  883.         CMP.W   #textObj,D3        ; mom. 'Object.type=textObj, boxTextObj, buttonObj,
  884.         BEQ     allocTed        ;       stringObj, fTextObj, fBoxTextObj, titleObj',
  885.         CMP.W   #boxTextObj,D3     ; dann springe zu 'allocTed'
  886.         BEQ     allocTed
  887.         CMP.W   #buttonObj,D3
  888.         BEQ     noMore
  889.         CMP.W   #stringObj,D3
  890.         BEQ     noMore
  891.         CMP.W   #fTextObj,D3
  892.         BEQ     allocTed
  893.         CMP.W   #fBoxTextObj,D3
  894.         BEQ     allocTed
  895.         CMP.W   #titleObj,D3
  896.         BEQ     noMore
  897.         CMP.W   #imageObj,D3       ; type=imageObj
  898.         BEQ     allocBit
  899.         CMP.W   #progDefObj,D3     ; type=progDefObj
  900.         BEQ     allocAppl
  901.         CMP.W   #iconObj,D3        ; type=iconObj
  902.         BEQ     allocIcon
  903.         SUBQ.L  #2, A3
  904.         BRA     err             ; sollte nie vorkommen
  905. allocIcon
  906.         MOVE.L  sizeOfIcon,(A3)+
  907.         BRA     alloc
  908. allocAppl
  909.         MOVE.L  sizeOfAppl,(A3)+
  910.         BRA     alloc
  911. allocBit
  912.         MOVE.L  sizeOfBit,(A3)+
  913.         BRA     alloc
  914. allocTed                        ; allociere 'TEdInfo'
  915.         MOVE.L  sizeOfTed,(A3)+
  916. alloc
  917.         MOVE.L  A0,-(A7)
  918.         
  919.         TST.W   sysTree
  920.         BNE     allocSys2
  921.         JSR     ALLOCATE        ; ALLOCATE(zws,TSIZE(...))
  922.         BRA     endAlloc2
  923. allocSys2
  924.         JSR     SysAlloc
  925. endAlloc2
  926.  
  927.         MOVE.L  (A7)+,A0
  928.         LEA     addr(A6),A1
  929.         MOVE.L  (A1),A1
  930.         BEQ     err             ; Kein Speicher => Fehler
  931.         MOVE.L  A1,(A0)         ; -> ObjSpec
  932.         BRA     ende
  933. noMore                          ; nichts mehr zu allocieren
  934.         CLR.L   (A0)
  935.         BRA     ende
  936. setIt                           ;       Setze 'Object.spec' entspr. A1
  937.         BTST    #indirectFlg,D0
  938.         BEQ     noSetIndirect   ; springe, falls 'indirectFlg' gelöscht
  939.         MOVE.L  (A4),A4         ; 'spec' dereferenzieren
  940. noSetIndirect
  941.         MOVE.L  currentObjAddr,A1
  942.         MOVE.L  A4,Object.spec(A1)      ; 'spec' -> mom. 'Object.spec'
  943.         BRA     ende
  944.         
  945. err
  946.         MOVE.W  #TRUE,objTreeError
  947. ende
  948.         MOVEM.L (A7)+,D3/A4     ; stelle D3 und A4 wieder her
  949.   END;
  950. END CreateSpecification;
  951. (*$L=*)
  952.          
  953. PROCEDURE SetBoxChar(obj:CARDINAL; ch:CHAR);
  954.  
  955. BEGIN
  956.   ASSEMBLER
  957.         MOVE.W  -(A3),-(A7)
  958.         JSR     setCurrObject
  959.         MOVE.W  (A7)+,(A3)+
  960.         TST.W   objTreeError
  961.         BNE     raiseErr
  962.         
  963.         JSR     validTree
  964.         MOVE.W  -(A3),objTreeError
  965.         BNE     err
  966.         JSR     objectType
  967.         MOVE.W  -(A3),D0
  968.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  969.         CMP.W   #boxCharObj,D0
  970.         BNE     raiseErr        ; Objecttyp#boxCharObj => Fehler
  971.         JSR     calcSpecAddr    ; Liefert Addr. ObjSpec in A0
  972.         TST.B   -(A3)
  973.         MOVE.B  -(A3),ObjSpec.letter(A0)
  974.         BRA     ende
  975. raiseErr
  976.         MOVE.W  #TRUE,objTreeError
  977. err
  978.         SUBQ.L  #2,A3
  979. ende
  980.   END;
  981. END SetBoxChar;
  982.          
  983. PROCEDURE BoxChar(obj:CARDINAL):CHAR;
  984.  
  985. BEGIN
  986.   ASSEMBLER
  987.         JSR     setCurrObject
  988.         TST.W   objTreeError
  989.         BNE     err
  990.         
  991.         JSR     validTree
  992.         MOVE.W  -(A3),objTreeError
  993.         BNE     err
  994.         JSR     objectType
  995.         MOVE.W  -(A3),D0
  996.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  997.         CMP.W   #boxCharObj,D0
  998.         BNE     raiseErr        ; Objecttyp#boxCharObj => Fehler
  999.         JSR     calcSpecAddr    ; Liefert Addr. von ObjSpec in A0
  1000.         CLR.W   D0
  1001.         MOVE.B  ObjSpec.letter(A0),(A3)+
  1002.         ADDQ.L  #1,A3
  1003.         BRA     ende
  1004. raiseErr
  1005.         MOVE.W  #TRUE,objTreeError
  1006. err
  1007.         CLR.W   (A3)+
  1008. ende
  1009.   END;
  1010. END BoxChar;
  1011.         
  1012. PROCEDURE SetBorderThickness(obj:CARDINAL; thick:SignedByte);
  1013.  
  1014. BEGIN
  1015.   ASSEMBLER
  1016.         MOVE.L  D3,-(A7)
  1017.         
  1018.         MOVE.W  -(A3),D3                ; 'thick' -> D3
  1019.         JSR     setCurrObject
  1020.         TST.W   objTreeError
  1021.         BNE     err
  1022.         
  1023.         JSR     validTree
  1024.         MOVE.W  -(A3),objTreeError
  1025.         BNE     err
  1026.         JSR     objectType
  1027.         JSR     calcSpecAddr            ; liefert Addr. der ObjSpec in A0
  1028.         MOVE.W  -(A3),D0                ; Ergebnis von objectType
  1029.         ANDI.W  #$00FF, D0              ; !MS high-byte bleibt unberücksichtigt
  1030.         CMP.W   #boxObj,D0
  1031.         BEQ     setBox
  1032.         CMP.W   #iBoxObj,D0
  1033.         BEQ     setBox
  1034.         CMP.W   #boxCharObj,D0
  1035.         BEQ     setBox
  1036.         CMP.W   #textObj,D0
  1037.         BEQ     setText
  1038.         CMP.W   #fTextObj,D0
  1039.         BEQ     setText
  1040.         CMP.W   #boxTextObj,D0
  1041.         BEQ     setText
  1042.         CMP.W   #fBoxTextObj,D0
  1043.         BEQ     setText
  1044.         MOVE.W  #TRUE,objTreeError      ; Unerlaubter Typ => Fehler
  1045.         BRA     ende
  1046. setBox
  1047.         MOVE.B  D3,ObjSpec.thickness(A0)
  1048.         BRA     ende
  1049. setText
  1050.         MOVE.L  (A0),A0
  1051.         AND.W   #$FF,D3
  1052.         MOVE.W  D3,TEdInfo.thickness(A0)
  1053. err
  1054. ende
  1055.         MOVE.L  (A7)+,D3
  1056.   END;
  1057. END SetBorderThickness;
  1058.          
  1059. PROCEDURE BorderThickness(obj:CARDINAL):SignedByte;
  1060.  
  1061. BEGIN
  1062.   ASSEMBLER
  1063.         JSR     setCurrObject
  1064.         TST.W   objTreeError
  1065.         BNE     err
  1066.         
  1067.         JSR     validTree
  1068.         MOVE.W  -(A3),objTreeError
  1069.         BNE     err
  1070.         JSR     objectType
  1071.         JSR     calcSpecAddr            ; liefert Addr. der ObjSpec in A0
  1072.         MOVE.W  -(A3),D0                ; Ergebnis von objectType
  1073.         ANDI.W  #$00FF, D0              ; !MS high-byte bleibt unberücksichtigt
  1074.         CMP.W   #boxObj,D0
  1075.         BEQ     setBox
  1076.         CMP.W   #iBoxObj,D0
  1077.         BEQ     setBox
  1078.         CMP.W   #boxCharObj,D0
  1079.         BEQ     setBox
  1080.         CMP.W   #textObj,D0
  1081.         BEQ     setText
  1082.         CMP.W   #fTextObj,D0
  1083.         BEQ     setText
  1084.         CMP.W   #boxTextObj,D0
  1085.         BEQ     setText
  1086.         CMP.W   #fBoxTextObj,D0
  1087.         BEQ     setText
  1088.         MOVE.W  #TRUE,objTreeError      ; Unerlaubter Typ => Fehler
  1089.         BRA     err
  1090. setBox
  1091.         MOVE.B  ObjSpec.thickness(A0),D1
  1092.         EXT.W   D1                      ; Vorzeichen erweitern
  1093.         MOVE.W  D1,(A3)+
  1094.         BRA     ende
  1095. setText
  1096.         MOVE.L  (A0),A0                 ; Hole Inhalt vom ObjSpec in A0
  1097.         MOVE.B  TEdInfo.thickness+1(A0),D1 ; Nur Lowbyte verwenden
  1098.         EXT.W   D1                      ; Vorzeichen erweitern
  1099.         MOVE.W  D1,(A3)+
  1100.         BRA     ende
  1101. err
  1102.         CLR.W   (A3)+
  1103. ende
  1104.   END;
  1105. END BorderThickness;
  1106.  
  1107. PROCEDURE SetComplexColor(obj:CARDINAL;
  1108.                           borderCol,textCol,fillCol,fillDensity:CARDINAL;
  1109.                           opaque:BOOLEAN);
  1110.                           
  1111. BEGIN
  1112.   ASSEMBLER
  1113.         MOVE.L  D3,-(A7)
  1114.         
  1115.         MOVE.W  -(A3),D1        ; Bitstruktur: aaaabbbbcdddeeee
  1116.         AND.W   #1,D1           ;  aaaa - Randfarbe
  1117.         LSL.W   #3,D1           ;  bbbb - Textfarbe
  1118.         MOVE.W  -(A3),D2        ;  c    - Schreibmodus
  1119.         AND.W   #7,D2           ;  ddd  - Fülldichte
  1120.         OR.W    D2,D1           ;  eeee - Füllfarbe
  1121.         LSL.W   #4,D1
  1122.         MOVE.W  -(A3),D2
  1123.         AND.W   #$F,D2
  1124.         OR.W    D2,D1
  1125.         MOVE.W  -(A3),D2
  1126.         AND.W   #$F,D2
  1127.         LSL.W   #8,D2
  1128.         OR.W    D2,D1
  1129.         MOVE.W  -(A3),D2
  1130.         AND.W   #$F,D2
  1131.         LSL.W   #8,D2
  1132.         LSL.W   #4,D2
  1133.         OR.W    D2,D1
  1134.         MOVE.W  D1,D3           ; Farbwort -> D3
  1135.         
  1136.         JSR     setCurrObject
  1137.         TST.W   objTreeError
  1138.         BNE     err
  1139.         
  1140.         JSR     validTree
  1141.         MOVE.W  -(A3),objTreeError
  1142.         BNE     err
  1143.         
  1144.         JSR     objectType
  1145.         JSR     calcSpecAddr
  1146.         MOVE.W  -(A3),D0        ; Object.type -> D0
  1147.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1148.         CMP.W   #boxObj,D0
  1149.         BEQ     setBox
  1150.         CMP.W   #iBoxObj,D0
  1151.         BEQ     setBox
  1152.         CMP.W   #boxCharObj,D0
  1153.         BEQ     setBox
  1154.         CMP.W   #textObj,D0
  1155.         BEQ     setText
  1156.         CMP.W   #fTextObj,D0
  1157.         BEQ     setText
  1158.         CMP.W   #boxTextObj,D0
  1159.         BEQ     setText
  1160.         CMP.W   #fBoxTextObj,D0
  1161.         BEQ     setText
  1162.         MOVE.W  #TRUE,objTreeError      ; Unerlaubter Typ => Fehler
  1163.         BRA     ende
  1164. setBox
  1165.         MOVE.W  D1,ObjSpec.color(A0)
  1166.         BRA     ende
  1167. setText
  1168.         MOVE.L  (A0),A0
  1169.         MOVE.W  D1,TEdInfo.color(A0)
  1170. err
  1171. ende
  1172.         MOVE.L  (A7)+,D3
  1173.   END;
  1174. END SetComplexColor;
  1175.          
  1176. PROCEDURE GetComplexColor(obj:CARDINAL;
  1177.                           VAR borderCol,textCol,fillCol,fillDensity:CARDINAL;
  1178.                           VAR opaque:BOOLEAN);
  1179.                           
  1180. BEGIN
  1181.   ASSEMBLER
  1182.         MOVE.W  -22(A3),(A3)+
  1183.         JSR     setCurrObject   ; setCurrObject(obj)
  1184.         TST.W   objTreeError
  1185.         BNE.W   err
  1186.         
  1187.         JSR     validTree
  1188.         MOVE.W  -(A3),objTreeError
  1189.         BNE.W   err
  1190.         JSR     objectType
  1191.         JSR     calcSpecAddr            ; liefert Addr. der ObjSpec in A0
  1192.         MOVE.W  -(A3),D0                ; Ergebnis von objectType
  1193.         ANDI.W  #$00FF, D0              ; !MS high-byte bleibt unberücksichtigt
  1194.         CMP.W   #boxObj,D0
  1195.         BEQ     setBox
  1196.         CMP.W   #iBoxObj,D0
  1197.         BEQ     setBox
  1198.         CMP.W   #boxCharObj,D0
  1199.         BEQ     setBox
  1200.         CMP.W   #textObj,D0
  1201.         BEQ     setText
  1202.         CMP.W   #fTextObj,D0
  1203.         BEQ     setText
  1204.         CMP.W   #boxTextObj,D0
  1205.         BEQ     setText
  1206.         CMP.W   #fBoxTextObj,D0
  1207.         BEQ     setText
  1208.         MOVE.W  #TRUE,objTreeError      ; Unerlaubter Typ => Fehler
  1209.         BRA     err
  1210. setBox
  1211.         MOVE.W  ObjSpec.color(A0),D1
  1212.         BRA     encrypt
  1213. setText
  1214.         MOVE.L  (A0),A0                 ; Hole Inhalt vom ObjSpec in A0
  1215.         MOVE.W  TEdInfo.color(A0),D1
  1216. encrypt
  1217.         CLR.W   D0
  1218.         BTST    #7,D1
  1219.         SEQ     D0
  1220.         ADDQ.B  #1,D0
  1221.         MOVE.L  -(A3),A0
  1222.         MOVE.W  D0,(A0)                 ; speichere 'opaque'
  1223.         MOVE.W  D1,D0
  1224.         LSR.W   #4,D0
  1225.         AND.W   #$7,D0
  1226.         MOVE.L  -(A3),A0
  1227.         MOVE.W  D0,(A0)                 ; speichere 'fillDensity'
  1228.         MOVE.W  D1,D0
  1229.         AND.W   #$F,D0
  1230.         MOVE.L  -(A3),A0
  1231.         MOVE.W  D0,(A0)                 ; speichere 'fillCol'
  1232.         LSR.W   #8,D1
  1233.         MOVE.W  D1,D0
  1234.         AND.W   #$F,D0
  1235.         MOVE.L  -(A3),A0
  1236.         MOVE.W  D0,(A0)                 ; speichere 'textCol'
  1237.         LSR.W   #4,D1
  1238.         MOVE.L  -(A3),A0
  1239.         MOVE.W  D1,(A0)                 ; speichere 'borderCol'
  1240.         BRA     ende
  1241. err
  1242.         SUBA.W  #20,A3
  1243. ende
  1244.         SUBQ.L  #2,A3
  1245.   END;
  1246. END GetComplexColor;
  1247.  
  1248. PROCEDURE SetIconColor(obj:CARDINAL; foreGround,backGround:CARDINAL);
  1249.  
  1250. BEGIN
  1251.   ASSEMBLER
  1252.         MOVE.W  -6(A3),(A3)+
  1253.         JSR     setCurrObject   ; setCurrObject(obj)
  1254.         TST.W   objTreeError
  1255.         BNE     err
  1256.         
  1257.         JSR     validTree
  1258.         MOVE.W  -(A3),objTreeError
  1259.         BNE     err
  1260.         JSR     objectType
  1261.         MOVE.W  -(A3),D0
  1262.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1263.         CMP.W   #iconObj,D0
  1264.         BNE     raiseErr
  1265.         JSR     calcSpecAddr    ; Ergebnis in A0
  1266.         MOVE.W  -(A3),D0
  1267.         AND.B   #$F,D0
  1268.         MOVE.W  -(A3),D1
  1269.         LSL.B   #4,D1
  1270.         OR.B    D1,D0
  1271.         MOVE.L  (A0),A0         ; Hole Zeiger auf IconBlock
  1272.         MOVE.B  D0,IconBlock.color(A0)
  1273.         BRA     ende
  1274. raiseErr
  1275.         MOVE.W  #TRUE,objTreeError
  1276. err
  1277.         SUBQ.L  #4,A3
  1278. ende
  1279.         SUBQ.L  #2,A3
  1280.   END;
  1281. END SetIconColor;
  1282.          
  1283. PROCEDURE GetIconColor(obj:CARDINAL; VAR foreGround,backGround:CARDINAL);
  1284.         
  1285. BEGIN
  1286.   ASSEMBLER
  1287.         MOVE.W  -10(A3),(A3)+
  1288.         JSR     setCurrObject   ; setCurrObject(obj)
  1289.         TST.W   objTreeError
  1290.         BNE     err
  1291.         
  1292.         JSR     validTree
  1293.         MOVE.W  -(A3),objTreeError
  1294.         BNE     err
  1295.         JSR     objectType
  1296.         MOVE.W  -(A3),D0
  1297.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1298.         CMP.W   #iconObj,D0
  1299.         BNE     raiseErr
  1300.         JSR     calcSpecAddr    ; Ergebnis in A0
  1301.         MOVE.L  (A0),A0         ; Hole Zeiger auf IconBlock
  1302.         MOVE.B  IconBlock.color(A0),D0
  1303.         MOVE.W  D0,D1
  1304.         AND.W   #$F,D1
  1305.         MOVE.L  -(A3),A0        ; speichere Hintergrund
  1306.         MOVE.W  D1,(A0)
  1307.         LSR.W   #4,D0
  1308.         AND.W   #$F,D0
  1309.         MOVE.L  -(A3),A0        ; speichere Vordergrund
  1310.         MOVE.W  D0,(A0)
  1311.         BRA     ende
  1312. raiseErr
  1313.         MOVE.W  #TRUE,objTreeError
  1314. err
  1315.         SUBQ.L  #8,A3
  1316. ende
  1317.         SUBQ.L  #2,A3
  1318.   END;
  1319. END GetIconColor;
  1320.         
  1321. PROCEDURE SetImageColor(obj:CARDINAL; color:CARDINAL);
  1322.         
  1323. BEGIN
  1324.   ASSEMBLER
  1325.         MOVE.L  D3,-(A7)
  1326.         
  1327.         MOVE.W  -(A3),D3
  1328.         JSR     setCurrObject   ; setCurrObject(obj)
  1329.         TST.W   objTreeError
  1330.         BNE     err
  1331.         
  1332.         JSR     validTree
  1333.         MOVE.W  -(A3),objTreeError
  1334.         BNE     err
  1335.         JSR     objectType
  1336.         MOVE.W  -(A3),D0
  1337.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1338.         CMP.W   #imageObj,D0
  1339.         BNE     raiseErr
  1340.         JSR     calcSpecAddr    ; Ergebnis in A0
  1341.         AND.B   #$F,D3
  1342.         MOVE.L  (A0),A0         ; Hole Zeiger auf IconBlock
  1343.         MOVE.W  D3,BitBlock.color(A0)
  1344.         BRA     ende
  1345. raiseErr
  1346.         MOVE.W  #TRUE,objTreeError
  1347. err
  1348. ende
  1349.         MOVE.L  (A7)+,D3
  1350.   END;
  1351. END SetImageColor;
  1352.          
  1353. PROCEDURE GetImageColor(obj:CARDINAL; VAR color:CARDINAL);
  1354.         
  1355. BEGIN
  1356.   ASSEMBLER
  1357.         MOVE.L  A4,-(A7)
  1358.         
  1359.         MOVE.L  -(A3),A4
  1360.         JSR     setCurrObject   ; setCurrObject(obj)
  1361.         TST.W   objTreeError
  1362.         BNE     err
  1363.         
  1364.         JSR     validTree
  1365.         MOVE.W  -(A3),objTreeError
  1366.         BNE     err
  1367.         JSR     objectType
  1368.         MOVE.W  -(A3),D0
  1369.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1370.         CMP.W   #imageObj,D0
  1371.         BNE     raiseErr
  1372.         JSR     calcSpecAddr    ; Ergebnis in A0
  1373.         MOVE.L  (A0),A0         ; Hole Zeiger auf IconBlock
  1374.         MOVE.W  BitBlock.color(A0),D0
  1375.         AND.B   #$F,D0
  1376.         MOVE.W  D0,(A4)
  1377.         BRA     ende
  1378. raiseErr
  1379.         MOVE.W  #TRUE,objTreeError
  1380. err
  1381.         SUBQ.L  #4,A3
  1382. ende
  1383.         MOVE.L  (A7)+,A4
  1384.   END;
  1385. END GetImageColor;
  1386.         
  1387. PROCEDURE SetTextForm(obj:CARDINAL; font:CARDINAL;just:THorJust);
  1388.  
  1389. BEGIN
  1390.   ASSEMBLER
  1391.         MOVE.L  -(A3),-(A7)
  1392.         JSR     setCurrObject   ; setCurrObject(obj)
  1393.         MOVE.L  (A7)+,(A3)+
  1394.         TST.W   objTreeError
  1395.         BNE     err
  1396.         
  1397.         JSR     validTree
  1398.         MOVE    -(A3),objTreeError
  1399.         BNE     err
  1400.         JSR     objectType
  1401.         JSR     calcSpecAddr    ; Ergebnis in A0
  1402.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1403.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1404.         CMP.W   #textObj,D0
  1405.         BEQ     typeOk
  1406.         CMP.W   #boxTextObj,D0
  1407.         BEQ     typeOk
  1408.         CMP.W   #fTextObj,D0
  1409.         BEQ     typeOk
  1410.         CMP.W   #fBoxTextObj,D0
  1411.         BEQ     typeOk
  1412.         MOVE.W  #TRUE,objTreeError      ; Falscher Objecttyp => Fehler
  1413.         BRA     err
  1414. typeOk
  1415.         MOVE.W  -(A3),D1        ; 'just' -> D1
  1416.         BEQ     cont
  1417.         CMP.W   #centerJust,D1
  1418.         BNE     isRight
  1419.         MOVEQ   #2,D1
  1420.         BRA     cont
  1421. isRight
  1422.         MOVEQ   #1,D1
  1423. cont
  1424.         MOVE.W  -(A3),D2        ; 'font' -> D2
  1425.         MOVE.L  (A0),A0
  1426.         MOVE.W  D1,TEdInfo.just(A0)
  1427.         MOVE.W  D2,TEdInfo.font(A0)
  1428.         BRA     ende
  1429. err
  1430.         SUBQ.L  #4,A3
  1431. ende
  1432.   END;
  1433. END SetTextForm;
  1434.          
  1435. PROCEDURE GetTextForm(obj:CARDINAL; VAR font:CARDINAL;VAR just:THorJust);
  1436.         
  1437. BEGIN
  1438.   ASSEMBLER
  1439.         MOVE.W  -10(A3),(A3)+
  1440.         JSR     setCurrObject   ; setCurrObject(obj)
  1441.         TST.W   objTreeError
  1442.         BNE     err
  1443.         
  1444.         JSR     validTree
  1445.         MOVE    -(A3),objTreeError
  1446.         BNE     err
  1447.         JSR     objectType
  1448.         JSR     calcSpecAddr    ; Ergebnis in A0
  1449.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1450.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1451.         CMP.W   #textObj,D0
  1452.         BEQ     typeOk
  1453.         CMP.W   #boxTextObj,D0
  1454.         BEQ     typeOk
  1455.         CMP.W   #fTextObj,D0
  1456.         BEQ     typeOk
  1457.         CMP.W   #fBoxTextObj,D0
  1458.         BEQ     typeOk
  1459.         MOVE.W  #TRUE,objTreeError      ; Falscher Objecttyp => Fehler
  1460.         BRA     err
  1461. typeOk
  1462.         MOVE.L  (A0),A0
  1463.         MOVE.W  TEdInfo.just(A0),D1
  1464.         BEQ     cont
  1465.         CMP.W   #2,D1
  1466.         BNE     isRight
  1467.         MOVEQ   #centerJust,D1
  1468.         BRA     cont
  1469. isRight
  1470.         MOVEQ   #rightJust,D1
  1471. cont
  1472.         MOVE.L  -(A3),A1
  1473.         MOVE.W  D1,(A1)
  1474.         MOVE.W  TEdInfo.font(A0),D1
  1475.         MOVE.L  -(A3),A1
  1476.         MOVE.W  D1,(A1)
  1477.         BRA     ende
  1478. err
  1479.         SUBQ.L  #8,A3
  1480. ende
  1481.         SUBQ.L  #2,A3
  1482.   END;
  1483. END GetTextForm;
  1484.         
  1485. PROCEDURE SetIconForm(obj:CARDINAL;
  1486.                       charPos:Point;iconFrame,textFrame:Rectangle);
  1487.  
  1488. BEGIN
  1489.   ASSEMBLER
  1490.         MOVE.W  -22(A3),(A3)+
  1491.         JSR     setCurrObject   ; setCurrObject(obj)
  1492.         TST.W   objTreeError
  1493.         BNE     err
  1494.         
  1495.         JSR     validTree
  1496.         MOVE.W  -(A3),objTreeError
  1497.         BNE     err
  1498.         JSR     objectType
  1499.         MOVE.W  -(A3),D0
  1500.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1501.         CMP.W   #iconObj,D0
  1502.         BNE     raiseErr
  1503.         JSR     calcSpecAddr
  1504.         MOVE.L  (A0),A0
  1505.         LEA     IconBlock.textFrame+8(A0),A0
  1506.         MOVEQ   #4,D0           ; kopiere (4+1)*4 Bytes
  1507. loop
  1508.         MOVE.L  -(A3),-(A0)
  1509.         DBF     D0,loop
  1510.         BRA     ende
  1511. raiseErr
  1512.         MOVE.W  #TRUE,objTreeError
  1513. err
  1514.         SUBA.W  #20,A3
  1515. ende
  1516.         SUBQ.L  #2,A3
  1517.   END;
  1518. END SetIconForm;
  1519.          
  1520. PROCEDURE GetIconForm(obj:CARDINAL;
  1521.                       VAR charPos:Point;VAR iconFrame,textFrame:Rectangle);
  1522.         
  1523. BEGIN
  1524.   ASSEMBLER
  1525.         MOVE.W  -14(A3),(A3)+
  1526.         JSR     setCurrObject   ; setCurrObject(obj)
  1527.         TST.W   objTreeError
  1528.         BNE     err
  1529.         
  1530.         JSR     validTree
  1531.         MOVE.W  -(A3),objTreeError
  1532.         BNE     err
  1533.         JSR     objectType
  1534.         MOVE.W  -(A3),D0
  1535.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1536.         CMP.W   #iconObj,D0
  1537.         BNE     raiseErr
  1538.         JSR     calcSpecAddr
  1539.         MOVE.L  (A0),A0
  1540.         LEA     IconBlock.textFrame+8(A0),A0
  1541.         MOVE.L  -(A3),A1
  1542.         MOVE.L  -(A0),4(A1)
  1543.         MOVE.L  -(A0),(A1)
  1544.         MOVE.L  -(A3),A1
  1545.         MOVE.L  -(A0),4(A1)
  1546.         MOVE.L  -(A0),(A1)
  1547.         MOVE.L  -(A3),A1
  1548.         MOVE.L  -(A0),(A1)
  1549.         BRA     ende
  1550. raiseErr
  1551.         MOVE.W  #TRUE,objTreeError
  1552. err
  1553.         SUBA.W  #12,A3
  1554. ende
  1555.         SUBQ.L  #2,A3
  1556.   END;
  1557. END GetIconForm;
  1558.         
  1559. PROCEDURE SetImageForm(obj:CARDINAL; byteWidth,height,deltaX,deltaY:INTEGER);
  1560.         
  1561. BEGIN
  1562.   ASSEMBLER
  1563.         MOVE.W  -10(A3),(A3)+
  1564.         JSR     setCurrObject   ; setCurrObject(obj)
  1565.         TST.W   objTreeError
  1566.         BNE     err
  1567.         
  1568.         JSR     validTree
  1569.         MOVE.W  -(A3),objTreeError
  1570.         BNE     err
  1571.         JSR     objectType
  1572.         MOVE.W  -(A3),D0
  1573.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1574.         CMP.W   #imageObj,D0
  1575.         BNE     raiseErr
  1576.         JSR     calcSpecAddr
  1577.         MOVE.L  (A0),A0
  1578.         MOVE.L  -(A3),BitBlock.x(A0)
  1579.         MOVE.L  -(A3),BitBlock.bytes(A0)
  1580.         BRA     ende
  1581. raiseErr
  1582.         MOVE.W  #TRUE,objTreeError
  1583. err
  1584.         SUBA.W  #8,A3
  1585. ende
  1586.         SUBQ.L  #2,A3
  1587.   END;
  1588. END SetImageForm;
  1589.          
  1590. PROCEDURE GetImageForm(obj:CARDINAL;
  1591.                        VAR byteWidth,height,deltaX,deltaY:INTEGER);
  1592.         
  1593. BEGIN
  1594.   ASSEMBLER
  1595.         MOVE.W  -18(A3),(A3)+
  1596.         JSR     setCurrObject   ; setCurrObject(obj)
  1597.         TST.W   objTreeError
  1598.         BNE     err
  1599.         
  1600.         JSR     validTree
  1601.         MOVE.W  -(A3),objTreeError
  1602.         BNE     err
  1603.         JSR     objectType
  1604.         MOVE.W  -(A3),D0
  1605.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1606.         CMP.W   #imageObj,D0
  1607.         BNE     raiseErr
  1608.         JSR     calcSpecAddr
  1609.         MOVE.L  (A0),A0
  1610.         LEA     BitBlock.y+2(A0),A0
  1611.         MOVEQ   #3,D0           ; 3+1 Parameter kopieren
  1612. loop
  1613.         MOVE.L  -(A3),A1
  1614.         MOVE.W  -(A0),(A1)
  1615.         DBF     D0,loop
  1616.         BRA     ende
  1617. raiseErr
  1618.         MOVE.W  #TRUE,objTreeError
  1619. err
  1620.         SUBA.W  #16,A3
  1621. ende
  1622.         SUBQ.L  #2,A3
  1623.   END;
  1624. END GetImageForm;
  1625.  
  1626. (*  setString -- geg.: Ein Wahlparameter 'choice', ein String 'str' und *
  1627.  *                     ein Zeiger auf einen String 'dest', 'minLen' ist *
  1628.  *                     die Mindestlänge des zu alloc. Str. bei 'create' *
  1629.  *               ges.: Falls 'choice=create' wird 'dest' allociert und  *
  1630.  *                     zwar mit 'length(str)+1' Elementen, danach oder  *
  1631.  *                     wenn 'choice=setOnly' wird 'str' in 'dest^' ko-  *
  1632.  *                     piert, wobei eine #0 angehängt wird. Ist 'choice=*
  1633.  *                     reCreate', dann wird die alte Var. dealloc. und  *
  1634.  *                     danach bei 'create' weitergemacht. Ist 'choice=  *
  1635.  *                     noChange', so wird überhaupt nichts verändert.   *
  1636.  *                     Zurückgegeben wird die Anzahl der kopierten Zei- *
  1637.  *                     chen+1                                           *)
  1638.  
  1639. PROCEDURE setString(choice:SetPtrChoice;REF str:ARRAY OF CHAR;
  1640.                     minLen:CARDINAL;VAR dest:PtrMaxStr):CARDINAL;
  1641.  
  1642. BEGIN
  1643.   ASSEMBLER
  1644.         MOVE.W  D3,-(A7)
  1645.         
  1646.         MOVE.L  -(A3),A2        ; 'dest' -> A2
  1647.         MOVE.W  -(A3),D3        ; 'minLen' -> D3
  1648.         CLR.L   D1
  1649.         MOVE.W  -(A3),D1        ; 'HIGH(str)' -> D1
  1650.         MOVE.L  -(A3),A1        ; 'ADR(str)' ->A1
  1651.         MOVE.W  -(A3),D0        ; 'choice' -> D0
  1652.         CMP.W   #noChange,D0
  1653.         BNE     changeIt
  1654.         MOVE.W  D3,D1           ; noChange => Gib 'minLen' zurück und term.
  1655.         BRA.W   cont3
  1656. changeIt
  1657.         CMP.W   #setOnly,D0
  1658.         BEQ     setValue        ; setOnly => springe zu String kopieren
  1659.         CMP.W   #reCreate,D0
  1660.         BNE     noDeAlloc
  1661.         MOVE.L  A2,(A3)+        ; reCreate => mache weiter mit Dealloc.
  1662.         CLR.L   (A3)+
  1663.         MOVEM.L D1/D3/A1-A2,-(A7)  ; mom. Version von DEALLOCATE? zerstört D3
  1664.         JSR     DEALLOCATE      ; DEALLOCATE(dest,0)
  1665.         MOVEM.L (A7)+,D1/D3/A1-A2
  1666. noDeAlloc
  1667.         MOVE.W  D1,D0
  1668.         MOVE.L  A1,A0
  1669. loop
  1670.         TST.B   (A0)+
  1671.         DBEQ    D0,loop
  1672.         MOVE.L  D1,D2           ; lösche auch high word
  1673.         SUB.W   D0,D2
  1674.         ADDQ.W  #1,D2           ; length(str)+1 -> D2
  1675.         CMP.W   D3,D2
  1676.         BCC     cont            ; jump, if 'minLen<length(str)+1'
  1677.         MOVE.W  D3,D2           ; mindestens 'minLen' alloc.
  1678. cont
  1679.         MOVE.W  D2,D3           ; merke dir wieviel Bytes alloc. wurden
  1680.         MOVE.L  A2,(A3)+
  1681.         MOVE.L  D2,(A3)+
  1682.         MOVEM.L D1/D3/A1-A2,-(A7)  ; mom. Version von ALLOCATE zerstört D3
  1683.         
  1684.         TST.W   sysTree
  1685.         BNE     allocSys1
  1686.         JSR     ALLOCATE        ; ALLOCATE(dest,length(str)+1)
  1687.         BRA     endAlloc1
  1688. allocSys1
  1689.         JSR     SysAlloc
  1690. endAlloc1
  1691.  
  1692.         MOVEM.L (A7)+,D1/D3/A1-A2
  1693. setValue
  1694.         MOVE.L  (A2),D0
  1695.         BEQ     err
  1696.         MOVE.L  D0,A2
  1697.         MOVE.W  D1,D0
  1698. loop2
  1699.         MOVE.B  (A1)+,(A2)+
  1700.         DBEQ    D0,loop2
  1701.         BEQ     cont2
  1702.         CLR.B   (A2)+           ; #0 anhängen
  1703.         SUBQ.W  #1,D0
  1704. cont2
  1705.         SUB.W   D0,D1
  1706.         CMP.W   D3,D1
  1707.         BCC     cont3           ; jump, if length(str)+1<minLen
  1708.         MOVE.W  D3,D1
  1709.         BRA     cont3
  1710. err
  1711.         MOVE.W  #TRUE,objTreeError
  1712.         CLR.W   D1
  1713. cont3
  1714.         MOVE.W  D1,(A3)+        ; Gib length(str)+1, aber min. 'minLen' zurück
  1715.         
  1716.         MOVE.W  (A7)+,D3
  1717.   END;
  1718. END setString;
  1719.         
  1720. PROCEDURE AssignTextStrings (obj        : CARDINAL;
  1721.                              textChoice : SetPtrChoice; REF textS: ARRAY OF CHAR;
  1722.                              tmpltChoice: SetPtrChoice; REF tmplt: ARRAY OF CHAR;
  1723.                              validChoice: SetPtrChoice; REF valid: ARRAY OF CHAR);
  1724.  
  1725. BEGIN
  1726.   ASSEMBLER
  1727.         MOVE.L  A4,-(A7)
  1728.         
  1729.         MOVE.W  -26(A3),(A3)+
  1730.         JSR     setCurrObject   ; setCurrObject(obj)
  1731.         TST.W   objTreeError
  1732.         BNE.W   err
  1733.         
  1734.         JSR     validTree
  1735.         MOVE.W  -(A3),objTreeError
  1736.         BNE.W   err
  1737.         JSR     objectType
  1738.         JSR     calcSpecAddr    ; Ergebnis in A0
  1739.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1740.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1741.         CMP.W   #textObj,D0
  1742.         BEQ     typeOk
  1743.         CMP.W   #boxTextObj,D0
  1744.         BEQ     typeOk
  1745.         CMP.W   #buttonObj,D0
  1746.         BEQ     onlyText
  1747.         CMP.W   #stringObj,D0
  1748.         BEQ     onlyText
  1749.         CMP.W   #fTextObj,D0
  1750.         BEQ     typeOk
  1751.         CMP.W   #fBoxTextObj,D0
  1752.         BEQ     typeOk
  1753.         CMP.W   #titleObj,D0
  1754.         BEQ     onlyText
  1755.         MOVE.W  #TRUE,objTreeError
  1756.         BRA     err
  1757. onlyText
  1758.         TST.W   -(A3)           ; Teste, daß 'choiceValid=noChange'
  1759.         TST.L   -(A3)
  1760.         MOVE.W  -(A3),D0
  1761.         CMP.W   #noChange,D0
  1762.         BEQ     skipValid
  1763.         MOVE.W  #TRUE,objTreeError
  1764. skipValid
  1765.         TST.W   -(A3)           ; Teste, daß 'choiceTmplt=noChange'
  1766.         TST.L   -(A3)
  1767.         MOVE.W  -(A3),D0
  1768.         CMP.W   #noChange,D0
  1769.         BEQ     skipTmplt
  1770.         MOVE.W  #TRUE,objTreeError
  1771. skipTmplt
  1772.         CLR.W   (A3)+
  1773.         MOVE.L  A0,(A3)+
  1774.         JSR     setString       ; 'textS' verarbeiten
  1775.         SUBQ.L  #2,A3
  1776.         BRA     ende
  1777. typeOk
  1778.         MOVE.L  (A0),A4
  1779.         CLR.W   (A3)+
  1780.         LEA     TEdInfo.validPtr(A4),A0
  1781.         MOVE.L  A0,(A3)+
  1782.         JSR     setString   ; setString(0,validChoice,valid,ADR(TEdInfo.validP))
  1783.         MOVE.W  -(A3),D0
  1784.         BEQ     noChg
  1785.         LEA     TEdInfo.textLen(A4),A0
  1786.         MOVE.W  D0,(A0)  ; 'TEdInfo.textLen':=Rückgabewert von 'setString'
  1787. noChg
  1788.         CLR.W   (A3)+
  1789.         LEA     TEdInfo.tmpltPtr(A4),A0
  1790.         MOVE.L  A0,(A3)+
  1791.         JSR     setString   ; setString(0,tmpltChoice,tmplt,ADR(TEdInfo.tmpltP))
  1792.         MOVE.W  -(A3),D0
  1793.         BEQ     noChg2
  1794.         LEA     TEdInfo.tmpltLen(A4),A0
  1795.         MOVE.W  D0,(A0)  ; 'TEdInfo.tmpltLen':=Rückgabewert von 'setString'
  1796. noChg2
  1797.         CLR.W   (A3)+
  1798.         LEA     TEdInfo.textPtr(A4),A0
  1799.         MOVE.L  A0,(A3)+
  1800.         JSR     setString   ; setString(x,textChoice,textObj,ADR(TEdInfo.textPtr))
  1801.         TST.W   -(A3)
  1802.         BRA     ende
  1803. err
  1804.         SUBA.L  #24,A3
  1805. ende
  1806.         SUBQ.L  #2,A3
  1807.  
  1808.         MOVE.L  (A7)+,A4
  1809.   END;
  1810. END AssignTextStrings;
  1811.          
  1812. PROCEDURE LinkTextString(obj:CARDINAL; str:PtrMaxStr);
  1813.  
  1814. BEGIN
  1815.   ASSEMBLER
  1816.         MOVE.W  -6(A3),(A3)+
  1817.         JSR     setCurrObject   ; setCurrObject(obj)
  1818.         TST.W   objTreeError
  1819.         BNE     err
  1820.         
  1821.         JSR     validTree
  1822.         MOVE.W  -(A3),objTreeError
  1823.         BNE     err
  1824.         JSR     objectType
  1825.         JSR     calcSpecAddr    ; Ergebnis in A0
  1826.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1827.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1828.         CMP.W   #textObj,D0
  1829.         BEQ     typeOk
  1830.         CMP.W   #boxTextObj,D0
  1831.         BEQ     typeOk
  1832.         CMP.W   #fTextObj,D0
  1833.         BEQ     typeOk
  1834.         CMP.W   #fBoxTextObj,D0
  1835.         BEQ     typeOk
  1836.         MOVE.W  #TRUE,objTreeError
  1837.         BRA     err
  1838. typeOk
  1839.         MOVE.L  (A0),A0
  1840.         MOVE.L  -(A3),A1        ; ADR(str) -> A1
  1841.         MOVE.L  A1,TEdInfo.textPtr(A0)
  1842.         ;CMP.W   TEdInfo.textLen(A0),D0
  1843.         ;BCC     ende            ; jump, if HIGH(str)>=TEdInfo.textLen
  1844.         ;MOVE.W  D0,TEdInfo.textLen(A0)  ; textLen darf höchstens HIGH(str) sein
  1845.         BRA     ende
  1846. err
  1847.         SUBQ.L  #4,A3
  1848. ende
  1849.         SUBQ.L  #2,A3
  1850.   END;
  1851. END LinkTextString;
  1852.  
  1853. (*  GetTextString -- Ist einer der Strings zu kurz, so tritt ein
  1854.  *                   Laufzeitfehler (STRING OVERFLOW) auf.
  1855.  *)
  1856.          
  1857. PROCEDURE GetTextStrings(obj:CARDINAL; VAR textS,tmplt,valid:ARRAY OF CHAR);
  1858.         
  1859. BEGIN
  1860.   ASSEMBLER
  1861.         MOVE.W  -20(A3),(A3)+
  1862.         JSR     setCurrObject   ; setCurrObject(obj)
  1863.         TST.W   objTreeError
  1864.         BNE.W   err
  1865.         
  1866.         JSR     validTree
  1867.         MOVE.W  -(A3),objTreeError
  1868.         BNE.W   err
  1869.         JSR     objectType
  1870.         JSR     calcSpecAddr    ; Ergebnis in A0
  1871.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1872.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1873.         CMP.W   #textObj,D0
  1874.         BEQ     typeOk
  1875.         CMP.W   #boxTextObj,D0
  1876.         BEQ     typeOk
  1877.         CMP.W   #buttonObj,D0
  1878.         BEQ     onlyText
  1879.         CMP.W   #stringObj,D0
  1880.         BEQ     onlyText
  1881.         CMP.W   #fTextObj,D0
  1882.         BEQ     typeOk
  1883.         CMP.W   #fBoxTextObj,D0
  1884.         BEQ     typeOk
  1885.         CMP.W   #titleObj,D0
  1886.         BEQ     onlyText
  1887.         MOVE.W  #TRUE,objTreeError
  1888.         BRA     err
  1889. onlyText
  1890.         SUBA.L  #12,A3          ; 'valid' und 'tmplt' vom A3-Stack schmeißen
  1891.         MOVE.L  (A0),A0         ; get spec. (ptr. to str.)
  1892.         MOVE.L  A0,-(A7)        ; 'textS' verarbeiten
  1893.         CLR.W   D0
  1894.         BRA     loop
  1895. typeOk
  1896.         MOVE.L  (A0),A0
  1897.         MOVE.L  TEdInfo.textPtr(A0),-(A7)
  1898.         MOVE.L  TEdInfo.tmpltPtr(A0),-(A7)
  1899.         MOVE.L  TEdInfo.validPtr(A0),-(A7)
  1900.         MOVEQ   #2,D0
  1901. loop
  1902.         MOVE.L  (A7)+,A0
  1903.         MOVE.W  -(A3),D1        ; HIGH(...) -> D1
  1904.         MOVE.L  -(A3),A1        ; ADR(...) -> A1
  1905. loop2
  1906.         MOVE.B  (A0)+,(A1)+
  1907.         DBEQ    D1,loop2
  1908.         BEQ     cont            ; letztes Zeichen 0C, so springe
  1909.         TST.B   (A0)+
  1910.         BEQ     cont            ; Wäre nächstes Zeichen 0C gewesen, so springe
  1911.         TRAP    #noErrorTrap
  1912.         DC.W    StringOverflow  ; Zielstring ist zu kurz !!
  1913. cont
  1914.         DBF     D0,loop
  1915.         BRA     ende
  1916. err
  1917.         SUBA.W  #18,A3
  1918. ende
  1919.         SUBQ.L  #2,A3
  1920.   END;
  1921. END GetTextStrings;
  1922.  
  1923. PROCEDURE SetStringLength(obj:CARDINAL; textLen,tmpltLen:CARDINAL);
  1924.         
  1925. BEGIN
  1926.   ASSEMBLER
  1927.         MOVE.L  -(A3),-(A7)
  1928.         JSR     setCurrObject   ; setCurrObject(obj)
  1929.         MOVE.L  (A7)+,(A3)+
  1930.         TST.W   objTreeError
  1931.         BNE     err
  1932.         
  1933.         JSR     validTree
  1934.         MOVE.W  -(A3),objTreeError
  1935.         BNE     err
  1936.         JSR     objectType
  1937.         JSR     calcSpecAddr    ; Ergebnis in A0
  1938.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1939.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1940.         CMP.W   #textObj,D0
  1941.         BEQ     typeOk
  1942.         CMP.W   #boxTextObj,D0
  1943.         BEQ     typeOk
  1944.         CMP.W   #fTextObj,D0
  1945.         BEQ     typeOk
  1946.         CMP.W   #fBoxTextObj,D0
  1947.         BEQ     typeOk
  1948.         MOVE.W  #TRUE,objTreeError
  1949.         BRA     err
  1950. typeOk
  1951.         MOVE.L  (A0),A0
  1952.         MOVE.W  -(A3),TEdInfo.tmpltLen(A0)
  1953.         MOVE.W  -(A3),TEdInfo.textLen(A0)
  1954.         BRA     ende
  1955. err
  1956.         SUBQ.W  #4,A3
  1957. ende
  1958.   END;
  1959. END SetStringLength;
  1960.  
  1961. PROCEDURE GetStringLength(obj:CARDINAL; VAR textLen,tmpltLen:CARDINAL);
  1962.  
  1963. BEGIN
  1964.   ASSEMBLER
  1965.         MOVE.W  -10(A3),(A3)+
  1966.         JSR     setCurrObject   ; setCurrObject(obj)
  1967.         TST.W   objTreeError
  1968.         BNE     err
  1969.         
  1970.         JSR     validTree
  1971.         MOVE.W  -(A3),objTreeError
  1972.         BNE     err
  1973.         JSR     objectType
  1974.         JSR     calcSpecAddr    ; Ergebnis in A0
  1975.         MOVE.W  -(A3),D0        ; 'Object.type' -> D0
  1976.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  1977.         CMP.W   #textObj,D0
  1978.         BEQ     typeOk
  1979.         CMP.W   #boxTextObj,D0
  1980.         BEQ     typeOk
  1981.         CMP.W   #fTextObj,D0
  1982.         BEQ     typeOk
  1983.         CMP.W   #fBoxTextObj,D0
  1984.         BEQ     typeOk
  1985.         MOVE.W  #TRUE,objTreeError
  1986.         BRA     err
  1987. typeOk
  1988.         MOVE.L  (A0),A0
  1989.         MOVE.L  -(A3),A1
  1990.         MOVE.W  TEdInfo.tmpltLen(A0),(A1)
  1991.         MOVE.L  -(A3),A1
  1992.         MOVE.W  TEdInfo.textLen(A0),(A1)
  1993.         BRA     ende
  1994. err
  1995.         SUBQ.W  #8,A3
  1996. ende
  1997.         SUBQ.L  #2,A3
  1998.   END;
  1999. END GetStringLength;
  2000.  
  2001. PROCEDURE SetImagePattern(obj:CARDINAL; pattern:PtrBitPattern);
  2002.  
  2003. BEGIN
  2004.   ASSEMBLER
  2005.         MOVE.L  -(A3),-(A7)
  2006.         JSR     setCurrObject   ; setCurrObject(obj)
  2007.         MOVE.L  (A7)+,(A3)+
  2008.         TST.W   objTreeError
  2009.         BNE     err
  2010.         
  2011.         JSR     validTree
  2012.         MOVE.W  -(A3),objTreeError
  2013.         BNE     err
  2014.         JSR     objectType
  2015.         JSR     calcSpecAddr
  2016.         MOVE.W  -(A3),D0
  2017.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  2018.         CMP.W   #imageObj,D0
  2019.         BEQ     typeOk
  2020.         MOVE.W  #TRUE,objTreeError
  2021.         BRA     err
  2022. typeOk
  2023.         MOVE.L  (A0),A0
  2024.         MOVE.L  -(A3),BitBlock.data(A0)
  2025.         BRA     ende
  2026. err
  2027.         SUBQ.L  #4,A3
  2028. ende
  2029.   END;
  2030. END SetImagePattern;
  2031.          
  2032. PROCEDURE GetImagePattern(obj:CARDINAL; VAR pattern:PtrBitPattern);
  2033.         
  2034. BEGIN
  2035.   ASSEMBLER
  2036.         MOVE.L  -(A3),-(A7)
  2037.         JSR     setCurrObject   ; setCurrObject(obj)
  2038.         MOVE.L  (A7)+,(A3)+
  2039.         TST.W   objTreeError
  2040.         BNE     err
  2041.         
  2042.         JSR     validTree
  2043.         MOVE.W  -(A3),objTreeError
  2044.         BNE     err
  2045.         JSR     objectType
  2046.         JSR     calcSpecAddr
  2047.         MOVE.W  -(A3),D0
  2048.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  2049.         CMP.W   #imageObj,D0
  2050.         BEQ     typeOk
  2051.         MOVE.W  #TRUE,objTreeError
  2052.         BRA     err
  2053. typeOk
  2054.         MOVE.L  (A0),A0
  2055.         MOVE.L  -(A3),A1
  2056.         MOVE.L  BitBlock.data(A0),(A1)
  2057.         BRA     ende
  2058. err
  2059.         SUBQ.L  #4,A3
  2060. ende
  2061.   END;
  2062. END GetImagePattern;
  2063.  
  2064. PROCEDURE SetIconLook(obj:CARDINAL; data,mask:PtrBitPattern;choice:SetPtrChoice;
  2065.                       REF str:ARRAY OF CHAR;ch:CHAR);
  2066.  
  2067. BEGIN
  2068.   ASSEMBLER
  2069.         MOVE.W  -20(A3),(A3)+
  2070.         JSR     setCurrObject   ; setCurrObject(obj)
  2071.         TST.W   objTreeError
  2072.         BNE     err
  2073.         
  2074.         JSR     validTree
  2075.         MOVE.W  -(A3),objTreeError
  2076.         BNE     err
  2077.         JSR     objectType
  2078.         JSR     calcSpecAddr
  2079.         MOVE.W  -(A3),D0
  2080.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  2081.         CMP.W   #iconObj,D0
  2082.         BEQ     typeOk
  2083.         MOVE.W  #TRUE,objTreeError
  2084.         BRA     err
  2085. typeOk
  2086.         MOVE.L  (A0),A0
  2087.         SUBQ.L  #1, A3
  2088.         MOVE.B  -(A3),IconBlock.oneChar(A0)
  2089.         CLR.W   (A3)+
  2090.         LEA     IconBlock.text(A0),A1
  2091.         MOVE.L  A1,(A3)+
  2092.         MOVE.L  A0,-(A7)
  2093.         JSR     setString       ; setString(choice,str,0,ADR(IconBlock.text))
  2094.         TST.W   -(A3)
  2095.         MOVE.L  (A7)+,A0
  2096.         MOVE.L  -(A3),IconBlock.mask(A0)
  2097.         MOVE.L  -(A3),IconBlock.data(A0)
  2098.         BRA     ende
  2099. err
  2100.         SUBA.W  #18,A3
  2101. ende
  2102.         SUBQ.L  #2,A3
  2103.   END;
  2104. END SetIconLook;
  2105.          
  2106. PROCEDURE GetIconLook(obj:CARDINAL;
  2107.                       VAR data,mask:PtrBitPattern;VAR str:ARRAY OF CHAR;
  2108.                       VAR ch:CHAR);
  2109.  
  2110. BEGIN
  2111.   ASSEMBLER
  2112.         MOVE.W  -20(A3),(A3)+
  2113.         JSR     setCurrObject   ; setCurrObject(obj)
  2114.         TST.W   objTreeError
  2115.         BNE     err
  2116.         
  2117.         JSR     validTree
  2118.         MOVE.W  -(A3),objTreeError
  2119.         BNE     err
  2120.         JSR     objectType
  2121.         JSR     calcSpecAddr
  2122.         MOVE.W  -(A3),D0
  2123.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  2124.         CMP.W   #iconObj,D0
  2125.         BEQ     typeOk
  2126.         MOVE.W  #TRUE,objTreeError
  2127.         BRA     err
  2128. typeOk
  2129.         MOVE.L  (A0),A0
  2130.         MOVE.L  -(A3),A1
  2131.         MOVE.B  IconBlock.oneChar(A0),(A1)
  2132.         MOVE.W  -(A3),D0
  2133.         MOVE.L  -(A3),A1
  2134.         MOVE.L  IconBlock.text(A0),A2
  2135. loop
  2136.         MOVE.B  (A2)+,(A1)+
  2137.         DBEQ    D0,loop
  2138.         BEQ     noOverflow
  2139.         TST.B   (A2)+
  2140.         BEQ     noOverflow
  2141.         TRAP    #noErrorTrap
  2142.         DC.W    StringOverflow
  2143. noOverflow
  2144.         MOVE.L  -(A3),A1
  2145.         MOVE.L  IconBlock.mask(A0),(A1)
  2146.         MOVE.L  -(A3),A1
  2147.         MOVE.L  IconBlock.data(A0),(A1)
  2148.         BRA     ende
  2149. err
  2150.         SUBA.W  #18,A3
  2151. ende
  2152.         SUBQ.L  #2,A3
  2153.   END;
  2154. END GetIconLook;
  2155.  
  2156.  
  2157. CONST   carrierCodeLen          =8;  (* Länge von 'carrierCode' in Worten *)
  2158.  
  2159. TYPE    carrierData             =RECORD
  2160.                                    proc         :ProgDefProc;
  2161.                                    wsp          :MemArea;
  2162.                                    (*futureUse    :LONGWORD;*)
  2163.                                  END;
  2164.         ptrCarrierData          =POINTER TO carrierData;
  2165.         progDefCarrier          =RECORD
  2166.                                    code         :ARRAY[0..carrierCodeLen-1]
  2167.                                                       OF WORD;
  2168.                                    data         :carrierData;
  2169.                                  END;
  2170.                                  
  2171. VAR     regA0,regUSP,regSSP    :LONGWORD;
  2172.         regsRmd                :ARRAY[0..13] OF LONGWORD;
  2173.                                  
  2174. (*  progDefHandler -- Proc. die bei jedem Neuzeichnen eines 'progDefObj'-Obj. *
  2175.  *                    vom GEM aufgerufen wird, der Aufruf erfolgt indirekt *
  2176.  *                    über den zur 'progDefProc' gehörenden Carrier.       *
  2177.  *                    Die Routine erwartet auf dem A7-Stack die Rücksprung-*
  2178.  *                    addr. zum GEM und in A0 einen Zeiger auf das Data-   *
  2179.  *                    segment des zuständigen 'progDefCarrier''s.          *)
  2180.                                  
  2181. PROCEDURE progDefHandler;
  2182.  
  2183. BEGIN
  2184.   ASSEMBLER
  2185.         MOVEM.L D0-D7/A1-A6,regsRmd
  2186.         MOVE.L  USP,A1
  2187.         MOVE.L  A1,regUSP
  2188.         MOVE.L  A7, regSSP
  2189.         ;MOVE.L  (A7)+,D0        ; C-mäßige Parameterübergabe
  2190.         ;MOVE.L  (A7)+,A1        ; Hole Zeiger auf ParamBlock in A1
  2191.         ;MOVE.L  D0,-(A7)
  2192.         MOVE.L  4(A7),A1        ; Hole Zeiger auf ParamBlock in A1
  2193.         MOVE.L  carrierData.wsp.bottom(A0),A3  ; Stackbereich einrichten
  2194.         MOVE.L  A3,A2
  2195.         ADDA.L  carrierData.wsp.length(A0),A2
  2196.         MOVE.L  A2,USP
  2197.         
  2198.         MOVE.L  (A1)+,(A3)+     ; Objektbaumaddr. kopieren
  2199.         MOVE.W  (A1)+,(A3)+     ; Objektindex und
  2200.         MOVEQ   #5,D0
  2201. loop
  2202.         MOVE.L  (A1)+,(A3)+     ; 6 Parameterlangwörter kopieren
  2203.         DBF     D0,loop
  2204.         ANDI.W  #-1-$2000,SR    ; Wechsle in den Usermode
  2205.         MOVE.L  carrierData.proc(A0),A0
  2206.         JSR     (A0)            ; Zeichenprocedure aufrufen
  2207.         LEA     regsRmd,A0      ; Rückgabewert der Proc C-mäßig in D0
  2208.         CLR.L   (A0)            ; zurückgeben
  2209.         MOVE.W  -(A3),2(A0)
  2210.         
  2211.         ; Zurück in Supervisormode
  2212.         CLR.L   -(A7)
  2213.         MOVE    #$20,-(A7)
  2214.         TRAP    #1
  2215.         ADDQ.L  #6, A7
  2216.         
  2217.         MOVE.L  regSSP, A7
  2218.         MOVE.L  regUSP,A1
  2219.         MOVE.L  A1,USP
  2220.         MOVEM.L regsRmd,D0-D7/A1-A6
  2221.         MOVE.L  regA0,A0
  2222.   END;
  2223. END progDefHandler;
  2224.  
  2225. (*  carrierCode -- Das Codesegment eines jeden 'progDefCarrier' *)
  2226.  
  2227. PROCEDURE carrierCode;  (* Konstante 'carrierCodeLen' beachten *)
  2228.  
  2229. BEGIN
  2230.   ASSEMBLER
  2231.         MOVE.L  A0,regA0                ; rette A0
  2232.         LEA     dataStart(PC),A0        ; ADR(progDefCarrier.data) -> A0
  2233.         JMP     progDefHandler          ; weiter beim eigentl. Handler
  2234. dataStart
  2235.   END;
  2236. END carrierCode;
  2237.  
  2238. PROCEDURE MakeProgDefProc(VAR hdl:ProgDefCarrier;proc:ProgDefProc;wsp:MemArea);
  2239.  
  2240. BEGIN
  2241.   ASSEMBLER
  2242.         MOVE.L  -(A3),D1
  2243.         MOVE.L  -(A3),D0
  2244.         MOVE.L  -(A3),A1
  2245.         MOVE.L  -(A3),A0        ; ADR(hdl) -> A0
  2246.         MOVE.L  A1,progDefCarrier.data.proc(A0) ; proc in den Carrier schreiben
  2247.         MOVE.L  D0,progDefCarrier.data.wsp.bottom(A0) ; 'wsp' in den Carrier
  2248.         MOVE.L  D1,progDefCarrier.data.wsp.length(A0) ; kopieren
  2249.         LEA     carrierCode,A1
  2250.         LEA     progDefCarrier.code(A0),A0
  2251.         (*$? carrierCodeLen # 8: ... folgende Kopier-Zeilen korrigieren! *)
  2252.         MOVE.L  (A1)+,(A0)+     ; kopiere 'carrierCode' in 'hdl'
  2253.         MOVE.L  (A1)+,(A0)+
  2254.         MOVE.L  (A1)+,(A0)+
  2255.         MOVE.L  (A1)+,(A0)+
  2256.   END;
  2257. END MakeProgDefProc;
  2258.  
  2259. PROCEDURE SetProgDefSpec(obj:CARDINAL; VAR hdl:ProgDefCarrier;param:LONGWORD);
  2260.  
  2261. BEGIN
  2262.   ASSEMBLER
  2263.         MOVE.W  -10(A3),(A3)+
  2264.         JSR     setCurrObject   ; setCurrObject(obj)
  2265.         TST.W   objTreeError
  2266.         BNE     err
  2267.         
  2268.         JSR     validTree
  2269.         MOVE.W  -(A3),objTreeError
  2270.         BNE     err
  2271.         JSR     objectType
  2272.         JSR     calcSpecAddr
  2273.         MOVE.W  -(A3),D0
  2274.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  2275.         CMP.W   #progDefObj,D0
  2276.         BEQ     typeOk
  2277.         MOVE.W  #TRUE,objTreeError
  2278.         BRA     err
  2279. typeOk
  2280.         MOVE.L  (A0),A0
  2281.         MOVE.L  -(A3),ApplBlock.parm(A0)
  2282.         MOVE.L  -(A3),ApplBlock.code(A0)
  2283.         BRA     ende
  2284. err
  2285.         SUBQ.L  #8,A3
  2286. ende
  2287.         SUBQ.L  #2,A3
  2288.   END;
  2289. END SetProgDefSpec;
  2290.  
  2291. PROCEDURE GetProgDefSpec(obj:CARDINAL; VAR proc:ProgDefProc;VAR param:LONGWORD);
  2292.  
  2293. BEGIN
  2294.   ASSEMBLER
  2295.         MOVE.W  -10(A3),(A3)+
  2296.         JSR     setCurrObject   ; setCurrObject(obj)
  2297.         TST.W   objTreeError
  2298.         BNE     err
  2299.         
  2300.         JSR     validTree
  2301.         MOVE.W  -(A3),objTreeError
  2302.         BNE     err
  2303.         JSR     objectType
  2304.         JSR     calcSpecAddr
  2305.         MOVE.W  -(A3),D0
  2306.         ANDI.W  #$00FF, D0      ; !MS high-byte bleibt unberücksichtigt
  2307.         CMP.W   #progDefObj,D0
  2308.         BEQ     typeOk
  2309.         MOVE.W  #TRUE,objTreeError
  2310.         BRA     err
  2311. typeOk
  2312.         MOVE.L  (A0),A0
  2313.         MOVE.L  -(A3),A1
  2314.         MOVE.L  ApplBlock.parm(A0),(A1)
  2315.         MOVE.L  -(A3),A1
  2316.         MOVE.L  ApplBlock.code(A0),A0   ; hole zugehörige Carrieraddresse
  2317.         MOVE.L  progDefCarrier.data.proc(A0),(A1)
  2318.         BRA     ende
  2319. err
  2320.         SUBQ.L  #8,A3
  2321. ende
  2322.         SUBQ.L  #2,A3
  2323.   END;
  2324. END GetProgDefSpec;
  2325.  
  2326.  
  2327. BEGIN
  2328.   sizeOfObject:=SHORT(TSIZE(Object));  (* Für Assembler-Routinen *)
  2329.   sizeOfTed:=TSIZE(TEdInfo);
  2330.   sizeOfIcon:=TSIZE(IconBlock);
  2331.   sizeOfBit:=TSIZE(BitBlock);
  2332.   sizeOfAppl:=TSIZE(ApplBlock);
  2333.   
  2334.   currentObjTree:=NIL;          (* Kein aktueller Baum *)
  2335.   currentObjAddr:=NIL;          (* =sizeOfObject*currentObject+currentObjTree *)
  2336.   currentObject:=NoObject;      (* Kein aktuelles Objekt *)
  2337.   endObject:=NoObject;          (* Kein letztes Objekt *)
  2338.   objTreeError:=FALSE;          (* Kein Fehler *)
  2339.   sysTree:=FALSE;
  2340. END ObjHandler.